home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib05.dsk / APPLE ARTIST.bas < prev    next >
BASIC Source File  |  2023-02-26  |  10KB  |  182 lines
  1. 2  REM ******************************
  2. 3  REM ** THE HI-RES SHAPEMAKER    **
  3. 4  REM **   BY TONY S. DAHBURA     **
  4. 5  REM ** COPYRIGHT (C) 1980 BY    **
  5. 6  REM **   MICRO-SPARC, INC.      **
  6. 7  REM **   LINCOLN, MA 01773      **
  7. 8  REM ******************************
  8. 10  REM  -------- END -------
  9. 20  LOMEM: 16386
  10. 30  IF  PEEK(2063) = 128  THEN 1500
  11. 40  GOTO 1260: REM  COLDSTART
  12. 50  REM  DRAW ****
  13. 60  HCOLOR= HC
  14. 70  POKE  -16297,0: POKE  -16304,0: GOSUB 540
  15. 80  GOSUB 480
  16. 90  GOSUB 530
  17. 100 K =  PEEK( -16384): IF K >127  THEN 150
  18. 110  IF C = 0  THEN C = 1: GOTO 130
  19. 120 C = 0
  20. 130  POKE 793,C: XDRAW 1 AT X,Y
  21. 140  GOTO 100
  22. 150  IF C = 1  THEN  XDRAW 1 AT X,Y
  23. 160 K = K -128
  24. 170  IF K < >13  AND K < >8  AND K < >47  AND K < >21  THEN 220
  25. 180  IF K = 13  THEN Y = Y -INC: GOTO 370
  26. 190  IF K = 47  THEN Y = Y +INC: GOTO 370
  27. 200  IF K = 21  THEN X = X +INC: GOTO 370
  28. 210  IF K = 8  THEN X = X -INC: GOTO 370
  29. 220  IF K = 12  AND LD < >1  THEN 910
  30. 230  IF K = 9  THEN  GOSUB 550: GOTO 360
  31. 240  IF K = 43  OR K = 59  THEN X = 279:Y = 191: GOTO 370
  32. 250  IF K = 45  OR K = 61  THEN X = 0:Y = 0: GOTO 370
  33. 260  IF K = 76  AND LD = 1  THEN  GOTO 950
  34. 270  IF K = 70  AND FS = 1  THEN P = P +1: GOTO 970
  35. 280  IF K = 1  THEN FS = 0:LD = 0:BD = 0:P = 0:LP = 0:DP = 0: GOTO 360
  36. 290  IF K = 16  THEN  GOSUB 620
  37. 300  IF K = 17  THEN  GOTO 1310
  38. 310  IF K = 27  THEN  GOSUB 660: GOTO 360
  39. 320  IF K = 2  AND BD < >1  THEN 1160
  40. 330  IF K = 66  AND BD = 1  THEN 1200
  41. 335  IF K = 63  THEN  GOSUB 642
  42. 340  IF K = 32  THEN  GOSUB 690: GOTO 360
  43. 350  IF K = 6  AND FS = 0  THEN  GOTO 970
  44. 360  GOSUB 530:C = 0: POKE 793,C: GOTO 100
  45. 370  IF X >279  THEN X = 279
  46. 380  IF X <0  THEN X = 0
  47. 390  IF Y >191  THEN Y = 191
  48. 400  IF Y <0  THEN Y = 0
  49. 410  GOSUB 530
  50. 420  IF X >255  THEN  POKE 786,255: POKE 787,X -255: GOTO 440
  51. 430  POKE 786,0: POKE 787,X
  52. 440  POKE 788,Y
  53. 450  IF PS$ = "OFF"  THEN 470
  54. 460  HCOLOR= HC: HPLOT  TO X,Y
  55. 470  GOSUB 480:C = 0: GOTO 100
  56. 480 X$ =  STR$(X): IF X <10  THEN X$ = "00" +X$: GOTO 500
  57. 490  IF X <100  THEN X$ = "0" +X$
  58. 500 Y$ =  STR$(Y): IF Y <10  THEN Y$ = "00" +Y$: GOTO 520
  59. 510  IF Y < = 100  THEN Y$ = "0" +Y$
  60. 520  VTAB (22): HTAB (9): PRINT X$: VTAB 23: HTAB (9): PRINT Y$: RETURN 
  61. 530  POKE  -16368,0: RETURN 
  62. 540  VTAB (22): PRINT "X COORD=  *";: HTAB 20: PRINT "'?'= CONTROLS": PRINT "Y COORD=  *": RETURN 
  63. 550  POKE  -16301,0: HOME : GOSUB 530: VTAB (22): PRINT "ENTER INCREMENT VALUE >";:R$ = PS$:PS$ = ""
  64. 560  GET A$:A =  VAL(A$): IF A <0  OR A >9  THEN 560
  65. 570  IF A = 0  THEN 590
  66. 580 INC = A
  67. 590  POKE 789,INC
  68. 600 P$ = "INCREMENT NOW EQUALS >" + STR$(INC): HOME : GOSUB 650
  69. 610  GOSUB 660: GOSUB 660: HOME : GOSUB 540: GOSUB 480:PS$ = R$: RETURN 
  70. 620  POKE  -16301,0: HOME : IF PS$ = "ON"  THEN PS$ = "OFF": POKE 791,0: GOTO 640
  71. 630 PS$ = "ON": POKE 791,1
  72. 640 P$ = "PLOTTER IS ": GOSUB 650: HOME : GOSUB 660: GOSUB 660: GOSUB 540: GOSUB 530: GOSUB 480: RETURN 
  73. 642  TEXT : HOME : PRINT "   USE CTRL KEY FOR FUNCTIONS": PRINT : PRINT "A)ABORT     B)BOX-IN MODE": PRINT "F)FILL-IN   I)SET INCREMENT": PRINT "L)LINE-DRAW P)PLOT TOGGLE": PRINT "Q)QUIT AND RETURN"
  74. 643  PRINT "SPACE-BAR - CHANGE COLOR": PRINT "ESC - TOGGLE FULL/MIXED SCREEN GRAPHICS": PRINT : PRINT 
  75. 644  PRINT "MOVEMENT : ": PRINT : PRINT "'RETURN' - UP": PRINT "<-- LEFT  RIGHT -->": PRINT "/ - DOWN": PRINT "'-' OR '=' PUT CURSOR AT LOWER LEFT": PRINT "';' OR '+' PUT CURSOR AT UPPER RIGHT": PRINT : PRINT "PRESS ANY KEY TO RETURN";
  76. 646  GOSUB 530: GET A$: PRINT : POKE  -16297,0: POKE  -16304,0:A =  PEEK(790): GOTO 740
  77. 650  INVERSE : VTAB 23: HTAB 18: PRINT P$;PS$: FOR ZZ = 1 TO 1000: NEXT ZZ: VTAB 23: HTAB 18: CALL  -868: NORMAL : RETURN 
  78. 660  IF ST = 0  THEN ST = 1: POKE  -16302,0: GOTO 680
  79. 670 ST = 0: POKE  -16301,0
  80. 680  GOSUB 530: POKE 792,ST: RETURN 
  81. 690  TEXT : GR : COLOR= 5: HLIN 19,28 AT 0: HLIN 19,28 AT 39: VLIN 0,39 AT 19: VLIN 0,39 AT 28:B = 19: GOSUB 530
  82. 700 A = 0: GOSUB 750:A = 12: GOSUB 750:A = 1: GOSUB 750:A = 15: GOSUB 750:A = 0: GOSUB 750:A = 9: GOSUB 750:A = 6: GOSUB 750
  83. 710 A = 15: GOSUB 750: HOME : VTAB 22: HTAB 21: PRINT "01234567": PRINT "COLOR IS NOW >";HC: PRINT "ENTER NUMBER (0-7)";
  84. 720  GET A$:A =  VAL(A$): IF A <0  OR A >7  THEN A = HC: GOTO 730
  85. 730  PRINT : HOME : PRINT "COLOR IS NUMBER >";A: FOR ZZ = 1 TO 1000: NEXT : POKE  -16297,0: POKE  -16304,0
  86. 740 HC = A: HOME : GOSUB 540: GOSUB 480: GOSUB 660: GOSUB 660: POKE 790,HC: HCOLOR= HC: RETURN 
  87. 750 B = B +1: COLOR= A: VLIN 1,38 AT B: RETURN 
  88. 760  REM  DISK I/O ROUTINE
  89. 770 D$ =  CHR$(4)
  90. 780  TEXT : HOME : GOSUB 530: PRINT : HTAB 20: IF  PEEK(785) = 1  THEN  PRINT "LOAD": GOTO 800
  91. 790  PRINT "SAVE"
  92. 800  PRINT : PRINT : HTAB 8: PRINT "CATALOG (Y/N)?";
  93. 810 K =  PEEK( -16384): IF K <128  THEN 810
  94. 820  GOSUB 530:K = K -128: IF K = 89  THEN  PRINT : PRINT D$;"CATALOG"
  95. 830  PRINT 
  96. 840  INPUT "FILENAME >";F1$: IF  LEN(F1$) = 0  THEN 1310
  97. 850  IF  PEEK(785) = 1  THEN 870
  98. 860  PRINT D$;"BSAVE ";F1$;",A$2000,L$1FF8":F2$ = F1$: GOTO 1310
  99. 870  PRINT "CURRENT PICTURE WILL BE LOST": INPUT "CONTINUE (YES/N)?";A$: IF  LEFT$(A$,1) = "Y"  THEN 890
  100. 880  GOTO 1310
  101. 890  PRINT D$;"BLOAD ";F1$;",A$2000":F2$ = F1$: GOTO 880
  102. 900  REM  *** DRAW LINE
  103. 910  GOSUB 530: POKE  -16301,0: HOME : VTAB 22: PRINT "MARK THE ENDPOINTS OF THE LINE"
  104. 920  PRINT "USE CTRL-A TO ABORT LINE DRAW": INVERSE : PRINT "PRESS A KEY";: GET A$
  105. 930  NORMAL : PRINT A$: GOSUB 530:PS$ = "OFF": POKE 791,0: GOSUB 660: GOSUB 660
  106. 940  HOME : VTAB 22: GOSUB 540: GOSUB 480:LD = 1:LP = 0: GOTO 360
  107. 950  GOSUB 530:LP = LP +1: IF LP = 1  THEN  VTAB 22: HTAB 18: PRINT  CHR$(7);"POINT 1": FOR ZZ = 1 TO 1000: NEXT : HTAB 18: VTAB 22: CALL  -868:LX = X:LY = Y: GOTO 360
  108. 960  HCOLOR= HC: HPLOT LX,LY TO X,Y:LD = 0:LP = 0: GOSUB 530: GOTO 360
  109. 970  IF P = 0  THEN 1010
  110. 980  IF P = 1  THEN 1060
  111. 990  IF P = 2  THEN 1080
  112. 1000  IF P =  >3  THEN P = 0: GOSUB 540: GOSUB 660: GOSUB 660: GOSUB 480: GOSUB 530:FS = 0: GOTO 360
  113. 1010  GOSUB 530: PRINT  CHR$(7); CHR$(7): POKE  -16301,0: HOME : VTAB 22
  114. 1020  PRINT "MARK THE UPPER LEFT AND LOWER RIGHT": PRINT "TYPE CTRL-A TO ABORT FILL-IN MODE"
  115. 1030  INVERSE : PRINT "PRESS A KEY TO CONTINUE";: GET A$: NORMAL : PRINT A$
  116. 1040  GOSUB 530: HOME : VTAB 22:PS$ = "OFF": POKE 791,0
  117. 1050  GOSUB 660: GOSUB 660: GOSUB 540: GOSUB 480:FS = 1:P = 0: GOTO 360
  118. 1060 XL = X:YL = Y: GOSUB 530: VTAB 22: HTAB 20: PRINT "POINT 1"; CHR$(7)
  119. 1070  FOR ZZ = 1 TO 1000: NEXT : VTAB 22: HTAB 19: CALL  -868: GOTO 360
  120. 1080 XR = X:YR = Y: VTAB 22: HTAB 20
  121. 1090  PRINT  CHR$(7); CHR$(7): VTAB 22: HTAB 20: CALL  -868: GOSUB 530
  122. 1100 FS = 0:P = 0: IF YL >YR  THEN S =  -1: GOTO 1120
  123. 1110 S = 1
  124. 1120  HCOLOR= HC
  125. 1130  FOR Z1 = YL TO YR  STEP S
  126. 1140  HPLOT XL,Z1 TO XR,Z1
  127. 1150  NEXT : GOSUB 530: GOTO 360
  128. 1160 DP = 0:BD = 1: POKE  -16301,0: HOME : PRINT : GOSUB 530: VTAB 22
  129. 1170  PRINT "MARK UPPER RIGHT AND LOWER LEFT CORNERS": PRINT "USE CTRL-A TO ABORT FRAME MODE"
  130. 1180  INVERSE : PRINT "PRESS A KEY TO CONTINUE";: GET A$: NORMAL : PRINT A$: HOME : VTAB 22:PS$ = "OFF"
  131. 1190  GOSUB 530: POKE 791,0: GOSUB 660: GOSUB 660: GOSUB 540: GOSUB 480: GOTO 360
  132. 1200 DP = DP +1: IF DP = 2  THEN 1230
  133. 1210  GOSUB 530: VTAB 22: HTAB 20: PRINT "POINT 1"; CHR$(7); CHR$(7)
  134. 1220  FOR ZZ = 1 TO 1000: NEXT : VTAB 22: HTAB 20: CALL  -868:BX = X:BY = Y: GOTO 360
  135. 1230  HCOLOR= HC: HPLOT BX,BY TO X,BY TO X,Y TO BX,Y TO BX,BY
  136. 1240  GOSUB 530:BD = 0:DP = 0: GOTO 360
  137. 1250  REM  MAIN MENU
  138. 1260  SCALE= 1: ROT= 0:HC = 3:INC = 1:ST = 0:PS$ = "OFF": HCOLOR= HC:X = 0:Y = 0:F2$ = "?": HGR : GOSUB 530: POKE 2063,128
  139. 1270  FOR ZZ = 786 TO 796: POKE ZZ,0: NEXT 
  140. 1280  POKE 790,HC: POKE 789,1: POKE 792,ST
  141. 1290  POKE 232,27: POKE 233,3: POKE 795,1: POKE 796,0: POKE 797,4: POKE 798,0: POKE 799,29: POKE 800,0: POKE 801,0
  142. 1300  POKE 216,0: ONERR  GOTO 1650
  143. 1310  PRINT : TEXT : HOME : NORMAL : SPEED= 255: GOSUB 530:FS = 0:LD = 0:BD = 0:P = 0:LP = 0:DP = 0
  144. 1320  POKE 1013,76: POKE 1014,102: POKE 1015,213
  145. 1330  HTAB 5: PRINT "**** THE HI-RES SHAPEMAKER ****": HTAB 12: PRINT "BY TONY DAHBURA": PRINT : HTAB 10: PRINT "COPYRIGHT (C) 1980 BY": HTAB 10: PRINT "  MICRO-SPARC, INC.  ": HTAB 10: PRINT "  LINCOLN MA 01773   "
  146. 1340  PRINT "LAST ACCESS :";F2$: PRINT : PRINT : HTAB 16: INVERSE : PRINT " MENU : ": NORMAL 
  147. 1350  PRINT : PRINT 
  148. 1360  HTAB 4: PRINT "1 - ENTER DRAW MODE": HTAB 4: PRINT "2 - LOAD A PICTURE": HTAB 4: PRINT "3 - SAVE A PICTURE"
  149. 1370  HTAB 4: PRINT "4 - CLEAR THE HIRES SCREEN": HTAB 4: PRINT "5 - EXIT PROGRAM": PRINT 
  150. 1380  PRINT "ENTER CHOICE >";
  151. 1390  GET A$:A =  VAL(A$): IF A <1  OR A >5  THEN 1390
  152. 1400  PRINT A: PRINT 
  153. 1410  IF A = 5  THEN  TEXT : HOME : POKE 216,0: END 
  154. 1420  IF A = 1  THEN  GOTO 50
  155. 1430  IF A = 2  THEN  POKE 785,1: GOTO 760
  156. 1440  IF A = 3  THEN  POKE 785,2: GOTO 760
  157. 1450  IF A = 4  THEN  PRINT : PRINT : INPUT "ARE YOU SURE (YES/N)? ";A$: IF A$ < >"YES"  THEN 1310
  158. 1460  CALL 62450: GOTO 1310
  159. 1470  PRINT  CHR$(7)"ERROR": END 
  160. 1480  END 
  161. 1490  REM  RESTORATION ROUTINE
  162. 1500  CLEAR :X =  PEEK(786) + PEEK(787):Y =  PEEK(788)
  163. 1510  GOSUB 530:INC =  PEEK(789):HC =  PEEK(790)
  164. 1520  IF  PEEK(791) = 0  THEN PS$ = "OFF": GOTO 1540
  165. 1530 PS$ = "ON"
  166. 1540 ST =  PEEK(792):C =  PEEK(793):F2$ = "?"
  167. 1550 C =   NOT C
  168. 1570  POKE 793,C: POKE 232,27: POKE 233,3: POKE 795,1: POKE 796,0: POKE 797,4: POKE 798,0: POKE 799,29: POKE 800,0: POKE 801,0
  169. 1580  IF C = 0  THEN  HCOLOR= 0: XDRAW 1 AT X,Y
  170. 1590  TEXT : HOME : PRINT : PRINT "TOTALLY RESTORED!!  YOU WILL NOW BE"
  171. 1600  PRINT : PRINT "RETURNED TO THE MAIN MENU": PRINT : PRINT 
  172. 1610  SCALE= 1: ROT= 0: POKE 216,0
  173. 1620  ONERR  GOTO 1650
  174. 1630  FOR ZZ = 1 TO 2000: NEXT : GOTO 1310
  175. 1640  REM  ERROR ROUTINE
  176. 1650 E =  PEEK(222)
  177. 1670  IF E = 6  THEN  PRINT "I COULD NOT FIND THE FILE!": GOTO 800
  178. 1680  IF E = 9  THEN  PRINT "THIS DISK IS FULL!": GOTO 800
  179. 1690  IF E = 10  THEN  PRINT "THE FILE ALREADY EXISTS": PRINT "DO YOU WANT ME TO OVERWRITE (Y/N)? ";: GOSUB 530: GET A$: PRINT : IF A$ = "Y"  THEN  PRINT D$;"UNLOCK ";F1$: GOTO 860
  180. 1700  IF E = 10  AND A$ < >"Y"  THEN 1310
  181. 1710  IF E = 8  THEN  PRINT "DRIVE IS OPEN! CLOSE AND PRESS A KEY ";: GOSUB 530: GET A$: PRINT : GOTO 850
  182. 1720  PRINT "ERROR #";E;" HAPPENED": INPUT "PLEASE CORRECT AND PRESS <C/R>";A$: GOSUB 530: PRINT : RESUME